home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Whiteline: Alpha
/
Whiteline Alpha.iso
/
progtool
/
modula2
/
hk_lib
/
def_mod
/
strings.mod
< prev
next >
Encoding:
Amiga
Atari
Commodore
DOS
FM Towns/JPY
Macintosh
Macintosh JP
Macintosh to JP
NeXTSTEP
RISC OS/Acorn
Shift JIS
UTF-8
Wrap
Modula Implementation
|
1994-09-22
|
78.2 KB
|
1,960 lines
IMPLEMENTATION MODULE Strings;
(*****************************************************************************)
(* Bei den meisten Prozeduren treten Zuweisungen von Strings auf, die fol- *)
(* gendes Schema haben: *)
(* _________________________________________________________________________ *)
(* *)
(* *)
(* IF HIGH(<Quellstring>) > HIGH(<Zielstring>) THEN *)
(* <max.Index> := HIGH(<Quellstring>); *)
(* ELSE *)
(* <max.Index> := HIGH(<Zielstring>); *)
(* END; *)
(* *)
(* <index> := <Anfangswert>; *)
(* WHILE (<Index> <= <max.Index>) & (<Quellstring>[<Index>] # EOS ) DO *)
(* <Zielstring>[<index>] := <Quellstring>[<index>]; *)
(* INC(<index>); *)
(* END; (* WHILE *) *)
(* *)
(* IF <Index> > HIGH(<Quellstring>) OR (<Quellstring>[<Index>] = EOS ) THEN*)
(* vollst := TRUE; *)
(* IF <index> <= HIGH(<Zielstring>) THEN *)
(* <Zielstring>[<index>] := EOS; *)
(* END; *)
(* ELSE *)
(* vollst := FALSE; *)
(* END; (* IF *) *)
(*___________________________________________________________________________*)
(* *)
(* Als erstes wird festgestellt, welcher String kuerzer ist. Die folgende *)
(* Zuweisungsschleife laeuft dann nur bis zum hoechsten Index des kuerzeren *)
(* Strings. Die Laufindex wird dann auf seinen Anfangswert ( meistens Null ) *)
(* gesetzt. *)
(* Dann wird die Zuweisungsschleife solange durchlaufen, bis entweder der *)
(* maximale Index des kuerzeren Strings ueberschritten ist ( Die Abbruchbe- *)
(* dingungen werden natuerlich vor der Zuweisung geprueft ),oder das naechste*)
(* Zeichen des Quellstrings das Nullbyte ist ( damit ist auf jeden Fall eine *)
(* vollstaendige Zuweisung erfolgt ). *)
(* Nach Beendigung der Schleife muss nun noch ueberprueft werden, ob die *)
(* Zuweisung durch das Ende des Quellstrings abgebrochen wurde ( dann ist die*)
(* Zuweisung vollstaendig ) oder durch das Ende des Zielstrings - dann wurde *)
(* der Quellstring nicht vollstaendig uebertragen *)
(* Ist der Laufindex um eins groesser als der maximale Feldindex des Quell-*)
(* strings ( HIGH( quelle ) ), oder ist das Zeichen des Quellstrings an der *)
(* Position des Laufindexes das Nullbyte, dann enthaelt der Zielstring den *)
(* vollstaendigen Quellstring, egal ob das Feld des Zielstrings ebenfalls *)
(* voellig belegt ist ( dann hatten beide Strings die gleiche Feldgroesse ). *)
(* Wenn der Zielstring aber noch Platz hat, muss sein Ende durch ein Nullbyte*)
(* gekennzeichnet werden. In allen anderen Faellen war die Zuweisung nicht *)
(* vollstaendig, und der Ausgangsparameter <vollst> teilt die der aufrufenden*)
(* Prozedur durch den Wert FALSE mit. *)
(*___________________________________________________________________________*)
(* *)
(* Achtung! Aufgrund der Repraesentation von Strings muessen bei einer *)
(* Schleife ueber die Laenge des Strings immer BEIDE Endebedingungen be- *)
(* achtet werden, d.h es ist zu pruefen *)
(* *)
(* 1. ob der Maximalindex des Strings erreicht ist (<index> <= HIGH( string)*)
(* *)
(* 2. ob das Nullbyte, dass das Ende des Strings kennzeichnet, erreicht ist.*)
(* *)
(* Das zweite Kriterium alleine reicht nicht aus, falls der String genauso *)
(* lang wie das Feld ist. *)
(* __________________________________________________________________________*)
(* *)
(* Die Zuweisung der Strings in Assembler sieht im Prinzip folgendermassen *)
(* aus: *)
(* *)
(* moveq #0, d1 ; Default: vollst := FALSE *)
(* *)
(* ; zuerst Adressen der Strings in Adressregister laden, denn durch die *)
(* ; Adr.art mit Postinkrement lassen sich die Indexvariablen einsparen *)
(* *)
(* movea.l quelle(a6), a0 ; ( register char *quelle ... ) *)
(* movea.l ziel(a6), a1 ; ( register char *ziel ... ) *)
(* : *)
(* : *)
(* *)
(* ; die maximale Laenge der Strings aus HIGH() ermitteln;das ist eine extra*)
(* ; Konstante, die den maximalen Index des Strings enthaelt und beim Proze-*)
(* ; duraufruf zusaetzlich zur Adresse des Strings auf dem Stack abgelegt *)
(* ; wird; ihr Wert kann vom Compiler schon waehrend der Uebersetzungszeit *)
(* ; aus der Stringdeklaration ermittelt werden. Damit die Schleife recht- *)
(* ; zeitig abgebrochen werden kann, wird der kleinere Wert genommen *)
(* *)
(* move.w QHIGH(a6), d0 ; d0 := MIN( HIGH(quelle), HIGH(ziel) ) *)
(* cmp.w ZHIGH(a6), d0 ; *)
(* bls.s asgnlp ; *)
(* move.w ZHIGH(a6), d0 ; *)
(* *)
(* ; In der Schleife wird jetzt der String solange zeichenweise zugewiesen *)
(* ; bis der maximale Index erreicht ist, oder ein Nullbyte kopiert wurde. *)
(* ; Mit dem DBEQ-Befehl lassen sich beide Bedingungen gleichzeitig testen: *)
(* ; Wurde ein Nullbyte kopiert, ist die Bedingung EQ wahr, und es wird mit *)
(* ; dem Befehl direkt dahinter fortgefahren; wenn die maximale Anzahl *)
(* ; Zeichen kopiert ist ( max. Anzahl = MIN(HIGH(quelle),HIGH(ziel)) + 1 ),*)
(* ; dann ist das Zaehlregister bei -1 gelandet, und es wird ebenfalls mit *)
(* ; dem naechsten Befehl fortgefahren. *)
(* *)
(* asgnlp: *)
(* move.b (a0)+, (a1)+ ; ein Zeichen kopieren *)
(* dbeq d0, asgnlp ; B: Quelle noch nicht vollstaendig kopiert *)
(* *)
(* ; Wurde die Schleife durch die Kopie eines Nullbytes abgebrochen, ist *)
(* ; alles erledigt, der Zielstring ist dann auch schon durch ebendieses *)
(* ; Nullbyte abgeschlossen. *)
(* *)
(* beq.s voll ; Zielstring ist schon mit 0C abgeschlossen *)
(* *)
(* ; Ansonsten wird aus dem jetzigen Wert des Quell-Adressregisters und der *)
(* ; Anfangsadresse des Quellstrings die Anzahl kopierter Zeichen ( = Index *)
(* ; nach Beendigung der Schleife ) berechnet und mit dem maximalen Index *)
(* ; verglichen; ist die Anzahl groesser, dann wurde der Quellstring voll- *)
(* ; staendig kopiert. *)
(* *)
(* move.l a0, d2 ; wird oefter gebraucht *)
(* movea.l quelle(a6), a2 ; a2 := Anzahl kopierter Zeichen( = Index ) *)
(* sub.l a2, d2 ; *)
(* cmp.w QHIGH(a6), d2 ; Index > HIGH(quelle) ? *)
(* bhi.s tsteos ; B: ja, Quelle vollstaendig kopiert *)
(* *)
(* ; ebenfalls vollstaendig kopiert wurde, falls zwar der Schleifenabbruch *)
(* ; durch das Ende des Zielstrings erfolgte aber hinter dem letzten kopier-*)
(* ; ten Zeichen im Quellstring ein Nullbyte folgt. *)
(* *)
(* tst.b (a0) ; hinter dem letzten kopierten Zeichen EOS ?*)
(* bne.s ende ; B: nein, dann Quelle nicht vollst. kopiert *)
(* *)
(* ; Ist der String vollstaendig kopiert, wird noch geprueft, ob der Ziel- *)
(* ; string durch ein Nullbyte abgeschlossen werden kann ( muss ). *)
(* ;Die geschieht ebenfalls durch den Vergleich der Anzahl kopierter Zeichen*)
(* ; mit dem maximalen Index des Zielstrings. *)
(* *)
(* tsteos: *)
(* cmp.w ZHIGH(a6), d2 ;Ist im Zielstring noch Platz fuer Nullbyte ?*)
(* bhi.s voll ; B: nein, Ziel voll *)
(* clr.b (a1) ; *)
(* *)
(* voll: *)
(* moveq #1, d1 *)
(* *)
(* ; Der Ausgangsparameter wird entsprechend der Vollstaendigkeit der Zuwei-*)
(* ; sung gesetzt, damit hat sichs dann. *)
(* *)
(* ende: *)
(* movea.l vollst(a6), a0 ; da <vollst> ein VAR-Parameter ist, erst- *)
(* ; mal die Adresse holen... *)
(* move.b d2, (a0) ; ...und <vollst> setzen *)
(* : *)
(* : *)
(* __________________________________________________________________________*)
(* *)
(* Die Assemblervarianten der Prozeduren sind bei Stringlaengen von 10 bis 20*)
(* Zeichen ungefaehr zwei- bis dreimal schneller als die MODULA-Versionen. *)
(* Je groesser die Stringlaengen sind, desto groesser wird der Geschwindig- *)
(* keitsvorteil, da der Verwaltungs-Overhead des Prozeduraufrufes im Ver- *)
(* haeltnis zur Dauer der Prozedur kleiner wird. *)
(* __________________________________________________________________________*)
(* *)
(* August '89 Beginn *)
(* 21-Sep-89 , hk *)
(* Erste Version *)
(* 29-Okt-89 , hk *)
(* Aufspaltung in zwei Module (-> "XStrings" ) *)
(* Aenderungen hier: Fehler in "Delete" und "RightPos" beseitigt *)
(* "Insert" und "LeftString" vereinfacht, "CompareASCII" -> "Compare"*)
(* "UpperString" -> "UpperCase". *)
(* Neue Typen: StringChar, String20, String80, String256, *)
(* CompareResult-Werte: kleine Anfangsbuchstaben, EOS nicht mehr *)
(* importiert, intern definiert, von "Chars" unabhaengig. *)
(* Neue Prozeduren: "Equal","CharToString","AssignChar","AppendChar",*)
(* "InsertChar",DeleteChar" *)
(* "ILength" entfallen *)
(* 01-Nov-89 , hk *)
(* Bereichsfehler ( negative CARD's ) in "InsertChar","LeftPos", *)
(* "RightPos" beseitigt *)
(* 05-Nov-89 , hk *)
(* "Length", "Assign", "LeftString", "Concat", "GetChar","AppendChar"*)
(* in Assembler *)
(* 24-Nov-89 , hk *)
(* Voellige Umstellung der Stringzuweisung, damit "Assign","Concat", *)
(* "SubString","LeftString","RightString" ,"UpperCase" praktisch neu *)
(* zu schreiben *)
(* "Equal","Compare","AssignChar","UpperCase" *)
(* in Assembler *)
(* 01-Dez-89 , hk *)
(* kleine Fehler in "InsertChar" verbessert, "InsertChar" und *)
(* "AppendChar" behandeln Nullbytes korrekt, d.h. sie ignorieren sie.*)
(* "LeftString","RightString" gemaess neuer Stringzuweisung *)
(* "InsertChar","DeleteChar","LeftString",RightString" in Assembler *)
(* 03-Dez-89 , hk *)
(* Fehler in "SubString": Allgemein gilt: Existiert ein Parameter mit*)
(* einer Positionsangabe,kann der Aufruf von "Length(string)" nicht *)
(* durch eine Schleife von <Startposition> bis zum Auftreten eines *)
(* Nullbytes oder dem Ueberschreiten des Index der Feldgrenze ersetzt*)
(* werden, da <Startposition> auch hinter dem Nullbyte aber vor *)
(* HIGH(string) liegen kann! *)
(* "SubString" gemaess neuer Stringzuweisung *)
(* CARDINAL-Ueberlauf in "SubString","Delete","LeftPos" beseitigt *)
(* "SubString","Delete" in Assembler *)
(* 07-Feb-90 , hk *)
(* Einige Aenderungen von Namen und Parameterreihenfolgen *)
(*****************************************************************************)
FROM SYSTEM IMPORT (* PROC *) VAL, INLINE;
(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
CONST EOS = 0C; (* dynamische Endekennung der Strings *)
(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
PROCEDURE t;
BEGIN
INLINE( 7200H,206EH,0018H,226EH,0010H,302EH,0000H,3400H,4A18H );
INLINE( 57C8H,0FFFCH,9440H,673AH,302EH,0016H,6734H,0B042H,6302H );
INLINE( 3002H,3600H,9440H,5340H,0B06EH,0014H,6304H,302EH,0014H );
INLINE( 206EH,0018H,0D0C2H,12D8H,51C8H,0FFFCH,2409H,246EH,0010H );
INLINE( 948AH,0B443H,650AH,0B46EH,0014H,6202H,4211H,7201H,206EH );
INLINE( 000CH,1081H );
END t;
PROCEDURE Length ((* EIN/ -- *) string: ARRAY OF CHAR ): CARDINAL;
(*T*)
(* VAR Index : CARDINAL; *)
BEGIN
(* Index := 0;
(* Endemarkierung suchen, oder Feldende, falls
* String Feld ausfuellt.
*)
WHILE ( Index <= VAL( CARDINAL, HIGH( string ))) &
( string[ Index ] # EOS )
DO
(* (0<=Index<=HIGH(string)) & ((0<=i<=Index) => (string[i] # EOS)
*)
INC( Index );
END;
(* ((Index=HIGH(string)+1) OR (string[Index] = EOS)) &
* ((0<=i<Index) => (string[i] # EOS ) )
*)
RETURN( Index );
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
string EQU 12 ; letzter Parameter immer mit Offset 12
HIGH EQU string+4
RETURN EQU HIGH+2 ; Platz fuer Funktionswert als erstes auf
; dem Stack
; Die Parameter werden beim Prozeduraufruf
; in der Reihenfolge ihres Auftretens im
; Programmtext auf den Stack kopiert -
; umgekehrt wie bei 'C'-Compilern. Ausserdem
; wird auch ein Funktionswert auf dem Stack
; uebergeben, nicht in Register D0 wie bei
; 'C'-Compilern
; ausserdem liegen die Parameter immer
; auf geraden Adressen, auch CHAR und BOOLEAN
Length:
movea.l string(a6), a0 ; a0 -> lokale Stringvariable
move.w HIGH(a6), d0 ; max. Index des Strings
move.w d0, d1
lenlp:
tst.b (a0)+ ; dyn. Ende des Strings erreicht ?
dbeq d0, lenlp ; B: nein, noch nicht
sub.w d0, d1 ; Length( string ) = HIGH( string ) - d0
move.w d1, RETURN(a6)
*)
INLINE( 206EH,000CH,302EH,0010H,3200H,4A18H,57C8H,0FFFCH,9240H );
INLINE( 3D41H,0012H );
END Length;
(* ------------------------------------------------------------------------- *)
PROCEDURE ClearStr ((* -- /AUS *) VAR string : ARRAY OF CHAR );
(*T*)
BEGIN
string[ 0 ] := EOS;
END ClearStr;
(* ------------------------------------------------------------------------- *)
PROCEDURE IsEmptyStr ((* EIN/ -- *) string : ARRAY OF CHAR ): BOOLEAN;
(*T*)
BEGIN
RETURN( string[ 0 ] = EOS );
END IsEmptyStr;
(* ------------------------------------------------------------------------- *)
PROCEDURE Assign ((* EIN/ -- *) quelle : ARRAY OF CHAR;
(* -- /AUS *) VAR ziel : ARRAY OF CHAR;
(* -- /AUS *) VAR vollst : BOOLEAN );
(*T*)
(* VAR Index,
MaxIndex : CARDINAL; *)
BEGIN
(* IF HIGH( quelle ) > HIGH( ziel ) THEN
MaxIndex := HIGH( ziel );
ELSE
MaxIndex := HIGH( quelle );
END;
Index := 0;
WHILE ( Index <= MaxIndex ) & ( quelle[ Index ] # EOS ) DO
(* (0<=Index<=HIGH(quelle)) & (0<=Index<=HIGH(ziel)) &
* ((0<=i<Index) => (ziel[i]=quelle[i])) &
* ((0<=i<=Index) => (quelle[i] # EOS))
*)
ziel[ Index ] := quelle[ Index ];
INC( Index );
END;
(* ((Index=HIGH(ziel)+1) OR (Index=HIGH(quelle)+1) OR
* (quelle[Index]=EOS) ) &
* ((0<=i<Index) => (ziel[i]=quelle[i] # EOS ) )
*)
IF ( Index > VAL( CARDINAL, HIGH( quelle ))) OR
( quelle[ Index ] = EOS )
THEN
vollst := TRUE;
IF Index <= VAL( CARDINAL, HIGH( ziel )) THEN
ziel[ Index ] := EOS;
END;
ELSE
vollst := FALSE;
END;
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
vollst EQU 12
ziel EQU vollst + 4
ZHIGH EQU ziel + 4
quelle EQU ZHIGH + 2
QHIGH EQU quelle + 4
Assign:
moveq #0, d1
movea.l quelle(a6), a0 ; a0 -> quelle, lokale Variable
movea.l ziel(a6), a1 ; a1 -> ziel
move.w QHIGH(a6), d0 ; d0 := MIN( HIGH(quelle), HIGH(ziel) )
cmp.w ZHIGH(a6), d0 ;
bls.s asgnlp ;
move.w ZHIGH(a6), d0 ;
asgnlp:
move.b (a0)+, (a1)+ ; ein Zeichen kopieren
dbeq d0, asgnlp ; B: Quelle noch nicht vollstaendig kopiert
beq.s voll ; Zielstring ist schon mit 0C abgeschlossen
move.l a0, d2 ; wird oefter gebraucht
movea.l quelle(a6), a2 ; d2 := Anzahl kopierter Zeichen( = Index )
sub.l a2, d2 ;
cmp.w QHIGH(a6), d2 ; Index > HIGH(quelle) ?
bhi.s tsteos ; B: ja, Quelle vollstaendig kopiert
tst.b (a0) ; hinter dem letzten kopierten Zeichen EOS ?
bne.s ende ; B: nein, dann Quelle nicht vollst. kopiert
tsteos:
cmp.w ZHIGH(a6), d2 ; Ist im Zielstring noch Platz fuer Nullbyte ?
bhi.s voll ; B: nein, Ziel voll
clr.b (a1) ;
voll:
moveq #1, d1
ende:
movea.l vollst(a6), a0 ; vollst VAR-Parameter !
move.b d1, (a0) ; vollst setzen
*)
INLINE( 7200H,206EH,0016H,226EH,0010H,302EH,001AH,0B06EH,0014H );
INLINE( 6304H,302EH,0014H,12D8H,57C8H,0FFFCH,671AH,2408H,246EH );
INLINE( 0016H,948AH,0B46EH,001AH,6204H,4A10H,660AH,0B46EH,0014H );
INLINE( 6202H,4211H,7201H,206EH,000CH,1081H );
END Assign;
(* ------------------------------------------------------------------------- *)
PROCEDURE Concat ((* EIN/ -- *) quelle1,
(* EIN/ -- *) quelle2 : ARRAY OF CHAR;
(* -- /AUS *) VAR ziel : ARRAY OF CHAR;
(* -- /AUS *) VAR vollst : BOOLEAN );
(*T*)
(* das gleiche wie "Assign", nur zweimal *)
(* VAR Index1,
Index2,
MaxIndex : INTEGER; (* kann auch negativ werden *) *)
BEGIN
(* IF HIGH( quelle1 ) > HIGH( ziel ) THEN
MaxIndex := HIGH( ziel );
ELSE
MaxIndex := HIGH( quelle1 );
END;
Index1 := 0;
WHILE ( Index1 <= MaxIndex ) & ( quelle1[ Index1 ] # EOS ) DO
ziel[ Index1 ] := quelle1[ Index1 ];
INC( Index1 );
END;
(* Index1 = Anzahl der bisher kopierten Zeichen *)
IF HIGH( quelle2 ) > ( HIGH( ziel ) - Index1 ) THEN
MaxIndex := HIGH( ziel ) - Index1;
(* Falls der Zielstring schon durch die erste Quelle vollstaendig
* belegt ist, gilt: MaxIndex = -1 , und die zweite Zuwei-
* sungsschleife wird nicht mehr ausgefuehrt.
*)
ELSE
MaxIndex := HIGH( quelle2 );
END; (* IF *)
Index2 := 0;
WHILE ( Index2 <= MaxIndex ) & ( quelle2[ Index2 ] # EOS ) DO
ziel[ Index1 ] := quelle2[ Index2 ];
INC( Index1 );
INC( Index2 );
END;
IF ( Index2 > HIGH( quelle2 )) OR ( quelle2[ Index2 ] = EOS ) THEN
vollst := TRUE;
IF Index1 <= HIGH( ziel ) THEN
ziel[ Index1 ] := EOS;
END;
ELSE
vollst := FALSE;
END;
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
vollst EQU 12
ziel EQU vollst + 4
ZHIGH EQU ziel + 4
quelle2 EQU ZHIGH + 2
Q2HIGH EQU quelle2 + 4
quelle1 EQU Q2HIGH + 2
Q1HIGH EQU quelle1 + 4
Concat:
moveq #0, d1
movea.l quelle1(a6), a0 ; a0 -> quelle, lokale Variable
movea.l ziel(a6), a1 ; a1 -> ziel
move.w Q1HIGH(a6), d0 ; d0 := MIN( HIGH(quelle1), HIGH(ziel) )
cmp.w ZHIGH(a6), d0 ;
bls.s cnct1lp ;
move.w ZHIGH(a6), d0 ;
cnct1lp:
move.b (a0)+, (a1)+ ; ein Zeichen kopieren
dbeq d0, cnct1lp ; B: Quelle noch nicht vollstaendig kopiert
bne.s clccnt ; B: <quelle1> war mit dem Feldende zuende
; oder <ziel>, aber in diesem Fall wird
; sowieso nichts mehr gemacht
subq.l #1, a1 ; sonst muss Nullbyte entfernt werden
clccnt:
move.l a1, d2 ; wird oefter gebraucht
movea.l quelle2(a6), a0 ; a0 -> <quelle2>
movea.l ziel(a6), a2 ; d2 := Anzahl kopierter Zeichen( = Index1 )
sub.l a2, d2 ;
move.w ZHIGH(a6), d0 ; d0 := noch freie Zeichen in <ziel> - 1
sub.w d2, d0
bcs.s tstvoll ; B: <ziel> ist schon voll
cmp.w Q2HIGH(a6), d0
bls.s cnct2lp
move.w Q2HIGH(a6), d0
cnct2lp:
move.b (a0)+, (a1)+ ; ein Zeichen kopieren
dbeq d0, cnct2lp ; B: Quelle noch nicht vollstaendig kopiert
beq.s voll
move.l a0, d2
movea.l quelle2(a6), a2
sub.l a2, d2
cmp.w Q2HIGH(a6), d2 ; Index > HIGH(quelle2) ?
bhi.s tsteos ; B: ja, Quelle vollstaendig kopiert
tstvoll:
tst.b (a0) ; hinter dem letzten kopierten Zeichen EOS ?
bne.s ende ; B: nein, dann Quelle nicht vollst. kopiert
tsteos:
move.l a1, d2
movea.l ziel(a6), a2
sub.l a2, d2
cmp.w ZHIGH(a6), d2 ; Ist im Zielstring noch Platz fuer Nullbyte ?
bhi.s voll ; B: nein, Ziel voll
clr.b (a1) ;
voll:
moveq #1, d1
ende:
movea.l vollst(a6), a0 ; vollst VAR-Parameter !
move.b d1, (a0) ; vollst setzen
*)
INLINE( 7200H,206EH,001CH,226EH,0010H,302EH,0020H,0B06EH,0014H );
INLINE( 6304H,302EH,0014H,12D8H,57C8H,0FFFCH,6602H,5389H,2409H );
INLINE( 206EH,0016H,246EH,0010H,948AH,302EH,0014H,9042H,6520H );
INLINE( 0B06EH,001AH,6304H,302EH,001AH,12D8H,57C8H,0FFFCH,6722H );
INLINE( 2408H,246EH,0016H,948AH,0B46EH,001AH,6204H,4A10H,6612H );
INLINE( 2409H,246EH,0010H,948AH,0B46EH,0014H,6202H,4211H,7201H );
INLINE( 206EH,000CH,1081H );
END Concat;
(* ------------------------------------------------------------------------- *)
PROCEDURE Delete ((* EIN/AUS *) VAR string : ARRAY OF CHAR;
(* EIN/ -- *) start,
(* EIN/ -- *) laenge : CARDINAL );
(*T*)
(* VAR StringLaenge : CARDINAL; *)
BEGIN
(* StringLaenge := Length( string );
IF start > 0 THEN
DEC( start );
END;
IF start < ( MAX(CARDINAL) - laenge ) THEN
INC( laenge, start );
ELSE
(* Abfrage vermeidet Ueberlauf *)
laenge := MAX(CARDINAL);
END;
(* <laenge> enthaelt den Index des ersten Zeichens des nach
* vorne zu verschiebenden Blocks.
*)
WHILE laenge < StringLaenge DO
string[ start ] := string[ laenge ];
INC( start ); INC( laenge );
END;
IF start <= VAL( CARDINAL, HIGH( string )) THEN
string[ start ] := EOS;
END;
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
laenge EQU 12
start EQU laenge + 2
string EQU start + 2
HIGH EQU string + 4
Delete:
movea.l string(a6), a0 ; a0 -> <string>
movea.l a0, a1
move.w HIGH(a6), d0 ; d0 := HIGH(string)
move.w d0, d2
lenlp:
tst.b (a0)+ ;
dbeq d0, lenlp ;
sub.w d0, d2 ; d2 := Length(string)
move.w start(a6), d0 ; d0 := <start>
beq.s clcidx
subq.w #1, d0
clcidx:
movea.l a1, a0 ; a0 -> <string>
adda.w d0, a1 ; a1 -> string[start]
add.w laenge(a6), d0 ; INC(laenge,start)
bcs.s exit ; Ueberlauf, alles ab <start> loeschen
adda.w d0, a0 ; a0 -> string[start+laenge]
sub.w d0, d2 ; Gibt es noch Zeichen hinter dem zu
; loeschenden Stringbereich ?
bls.s exit ; B: nein, Stringende bei string[start]
bra.s dellp + 2
dellp:
move.b (a0)+, (a1)+
dbra d2, dellp
exit:
move.l a1, d2 ; d2 := ZielIndex
movea.l string(a6), a0 ;
sub.l a0, d2 ;
cmp.w HIGH(a6), d2 ; Ist im Zielstring noch Platz fuer Nullbyte ?
bhi.s ende ; B: nein, Ziel voll
clr.b (a1) ; <ziel>-Ende kennzeichnen
ende:
*)
INLINE( 206EH,0010H,2248H,302EH,0014H,3400H,4A18H,57C8H,0FFFCH );
INLINE( 9440H,302EH,000EH,6702H,5340H,2049H,0D2C0H,0D06EH,000CH );
INLINE( 650EH,0D0C0H,9440H,6308H,6002H,12D8H,51CAH,0FFFCH,2409H );
INLINE( 206EH,0010H,9488H,0B46EH,0014H,6202H,4211H );
END Delete;
(* ------------------------------------------------------------------------- *)
PROCEDURE Insert ((* EIN/ -- *) insert : ARRAY OF CHAR;
(* EIN/ -- *) start : CARDINAL;
(* EIN/AUS *) VAR string : ARRAY OF CHAR;
(* -- /AUS *) VAR vollst : BOOLEAN );
(*T*)
VAR Frei,
StringLaenge,
InsertLaenge,
Index : INTEGER;
BEGIN
vollst := TRUE;
StringLaenge := Length( string );
InsertLaenge := Length( insert );
IF start > 0 THEN
DEC( start );
IF start > VAL( CARDINAL, StringLaenge ) THEN
start := StringLaenge; (* <insert> hinten dran *)
END;
END;
(* 0 <= start <= Length( string ) *)
Frei := HIGH( string ) + 1 - StringLaenge - InsertLaenge;
IF Frei < 0 THEN
(* ABS( Frei ) enthaelt die Anzahl der Zeichen, die dem
* Ergebnisstring zum vollstaendigen Ergebnis fehlen.
*)
INC( StringLaenge, Frei );
(* StringLaenge enthaelt die Anzahl der Zeichen von <string>
* im Ergebnisstring, falls noch etwas von <string> hinter
* <insert> steht
*)
vollst := FALSE; (* Es passt nicht alles rein *)
IF HIGH( string ) + 1 - VAL( INTEGER, start ) < InsertLaenge THEN
InsertLaenge := HIGH( string ) + 1 - VAL( INTEGER, start );
END;
(* InsertLaenge enthaelt die Anzahl der Zeichen von <insert>
* im Ergebnisstring.
*)
ELSIF Frei > 0 THEN (* noch zus. Platz fuer Nullbyte *)
string[ StringLaenge + InsertLaenge ] := EOS;
END; (* IF Frei *)
(* Schleife wird nicht ausgefuehrt, falls angefuegt werden soll,
* oder der zu verschiebende Teil von <string> vollstaendig ausser-
* halb des Feldes liegt.
*
* Wenn man einen Bereich ueberlappend nach 'hinten' kopiert, muss
* man auch von 'hinten' mit dem Kopieren beginnen, sonst wird dabei
* die Quelle ueberschrieben. Beim Kopieren nach 'vorne' hingegen,
* muss man mit dem Anfang beginnen.
*)
FOR Index := StringLaenge - 1 TO VAL( INTEGER, start ) BY -1 DO
string[ Index + InsertLaenge ] := string[ Index ];
END; (* FOR *)
(* <insert> ab <pos> einfuegen *)
FOR Index := 0 TO InsertLaenge - 1 DO
string[ VAL( INTEGER, start ) + Index ] := insert[ Index ];
END; (* FOR *)
END Insert;
(* ------------------------------------------------------------------------- *)
PROCEDURE EqualStr ((* EIN/ -- *) string1,
(* EIN/ -- *) string2 : ARRAY OF CHAR ): BOOLEAN;
(*T*)
(* VAR Index,
MaxIndex : CARDINAL; *)
BEGIN
(* Index := 0;
IF HIGH( string1 ) < HIGH( string2 ) THEN
MaxIndex := HIGH( string1 );
ELSE
MaxIndex := HIGH( string2 );
END;
(* MaxIndex = MIN( HIGH( string1 ), HIGH( string2 ))
*)
LOOP
IF Index > MaxIndex THEN
EXIT;
ELSIF string1[ Index ] # string2[ Index ] THEN
RETURN( FALSE );
ELSIF string1[ Index ] = EOS THEN
(* Wenn string1 = 0C, dann auch string2
*)
RETURN( TRUE );
END; (* IF *)
INC( Index );
END; (* LOOP *)
(* Index = MaxIndex + 1
*
* Strings sind auch gleich, falls der eine das ARRAY fuellt
* und der andere hinter dem letzten verglichenen Zeichen
* mit "EOS" abgeschlossen ist
*)
RETURN( NOT (( HIGH( string1 ) < HIGH( string2 )) &
( string2[ Index ] # EOS ) ) OR
(( HIGH( string1 ) > HIGH( string2 )) &
( string1[ Index ] # EOS ) ) );
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
string2 EQU 12
HIGH2 EQU string2 + 4
string1 EQU HIGH2 + 2
HIGH1 EQU string1 + 4
RETURN EQU HIGH1 + 2
EqualStr:
moveq #0, d2 ; Default: Strings ungleich
movea.l string1(a6), a0 ; a0 -> string1
movea.l string2(a6), a1 ; a1 -> string2
move.w HIGH1(a6), d0 ; d0 := MIN( HIGH(string1),HIGH(string2))
cmp.w HIGH2(a6), d0 ;
bls.s eqlp ;
move.w HIGH2(a6), d0 ;
eqlp:
move.b (a0)+, d1 ; Ist naechstes string1-Zeichen = EOS ?
beq.s tst2eos ; B: ja, Schleife zuende und string2-EOS-Test
cmp.b (a1)+, d1 ; sonst mit naechstem string2-Zeichen vergl.
dbne d0, eqlp ; B: sind noch gleich und nicht zuende
bne.s ende ; B: unterschiedliches Zeichen entdeckt
move.w HIGH1(a6), d0 ; string1-Feld groesser als string2-Feld ?
cmp.w HIGH2(a6), d0 ;
beq.s true ; B: sind gleich, also Strings gleich
blo.s tst2eos ; B: nein, kleiner, also string2-Ende-Test
tst.b (a0) ; sonst testen, ob auch string1 zuende
beq.s true ; B: ja, Strings gleich
bra.s ende ; B: string1 nicht zuende -> unterschiedl.
tst2eos:
tst.b (a1) ; string2 zuende ?
bne.s ende ; B: nein, string2 laenger -> ungleich
true:
moveq #1, d2
ende:
move.b d2, RETURN(a6)
*)
INLINE( 7400H,206EH,0012H,226EH,000CH,302EH,0016H,0B06EH,0010H );
INLINE( 6304H,302EH,0010H,1218H,671AH,0B219H,56C8H,0FFF8H,6618H );
INLINE( 302EH,0016H,0B06EH,0010H,670CH,6506H,4A10H,6706H,6006H );
INLINE( 4A11H,6602H,7401H,1D42H,0018H );
END EqualStr;
(* ------------------------------------------------------------------------- *)
PROCEDURE EqualCAPStr ((* EIN/ -- *) string1,
(* EIN/ -- *) string2 : ARRAY OF CHAR ): BOOLEAN;
(*T*)
(* Wie "Equal", nur Vergleich mit CAP() *)
(* VAR Index,
MaxIndex : CARDINAL; *)
BEGIN
(* Index := 0;
IF HIGH( string1 ) < HIGH( string2 ) THEN
MaxIndex := HIGH( string1 );
ELSE
MaxIndex := HIGH( string2 );
END;
LOOP
IF Index > MaxIndex THEN
EXIT;
ELSIF CAP( string1[ Index ] ) # CAP( string2[ Index ] ) THEN
RETURN( FALSE );
ELSIF string1[ Index ] = EOS THEN
RETURN( TRUE );
END;
INC( Index );
END;
RETURN( NOT (( HIGH( string1 ) < HIGH( string2 )) &
( string2[ Index ] # EOS ) ) OR
(( HIGH( string1 ) > HIGH( string2 )) &
( string1[ Index ] # EOS ) ) );
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
string2 EQU 12
HIGH2 EQU string2 + 4
string1 EQU HIGH2 + 2
HIGH1 EQU string1 + 4
RETURN EQU HIGH1 + 2
EqualCAPStr:
moveq #0, d2 ; Default: Strings ungleich
movea.l string1(a6), a0 ; a0 -> string1
movea.l string2(a6), a1 ; a1 -> string2
move.w HIGH1(a6), d0 ; d0 := MIN( HIGH(string1),HIGH(string2))
cmp.w HIGH2(a6), d0 ;
bls.s eqlp ;
move.w HIGH2(a6), d0 ;
eqnclp:
move.b (a0)+, d1 ; Ist naechstes string1-Zeichen = EOS ?
beq.s tst2eos ; B: ja, Schleife zuende und string2-EOS-Test
move.b (a1)+, d3 ; sonst mit naechstem <string2>-Zeichen
cmp.b d1, d3 ; vergleichen
beq.s lpcnt ; B: sind gleich, naechstes Zeichen
andi.b #%11011111, d1 ; mal probieren ob's an Gross/Klein-
andi.b #%11011111, d3 ; schreibung liegt
cmp.b d1, d3 ;
bne.s ende ; B: nein, also nicht gleich
cmpi.b #'A', d1 ; Konvertierung klein -> gross hat natuer-
; lich nur Sinn, wenn es sich um Buchstaben
; handelt
blo.s ende ; B: war kein Buchstabe, also ungleich
cmpi.b #'Z', d1
bhi.s ende ; B: kein Buchstabe -> ungleich
lpcnt:
dbra d0, eqnclp ; B: bisher gleich, noch nicht alle vergl.
move.w HIGH1(a6), d0 ; string1-Feld groesser als string2-Feld ?
cmp.w HIGH2(a6), d0 ;
beq.s true ; B: sind gleich, also Strings gleich
blo.s tst2eos ; B: nein, kleiner, also string2-Ende-Test
tst.b (a0) ; sonst testen, ob auch string1 zuende
beq.s true ; B: ja, Strings gleich
bra.s ende ; B: string1 nicht zuende -> unterschiedl.
tst2eos:
tst.b (a1) ; string2 zuende ?
bne.s ende ; B: nein, string2 laenger -> ungleich
true:
moveq #1, d2
ende:
move.b d2, RETURN(a6)
*)
INLINE( 7400H,206EH,0012H,226EH,000CH,302EH,0016H,0B06EH,0010H );
INLINE( 6304H,302EH,0010H,1218H,6734H,1619H,0B601H,6718H,0201H );
INLINE( 00DFH,0203H,00DFH,0B601H,6628H,0C01H,0041H,6522H,0C01H );
INLINE( 005AH,621CH,51C8H,0FFDCH,302EH,0016H,0B06EH,0010H,670CH );
INLINE( 6506H,4A10H,6706H,6006H,4A11H,6602H,7401H,1D42H,0018H );
END EqualCAPStr;
(* ------------------------------------------------------------------------- *)
PROCEDURE Compare ((* EIN/ -- *) string1,
(* EIN/ -- *) string2 : ARRAY OF CHAR ): CompareResult;
(*T*)
(* VAR Index,
MaxIndex : CARDINAL; *)
BEGIN
(* Index := 0;
IF HIGH( string1 ) < HIGH( string2 ) THEN
MaxIndex := HIGH( string1 );
ELSE
MaxIndex := HIGH( string2 );
END;
(* MaxIndex = MIN( HIGH( string1 ), HIGH( string2 ))
*)
LOOP
IF Index > MaxIndex THEN
EXIT;
ELSIF string1[ Index ] # string2[ Index ] THEN
(* Ergebnis aus dem ersten unterschiedlichen Zeichen bilden
*)
IF string1[ Index ] < string2[ Index ] THEN
RETURN( less );
ELSE
RETURN( greater );
END;
ELSIF string1[ Index ] = EOS THEN
RETURN( equal );
END; (* IF *)
INC( Index );
END; (* LOOP *)
(* Index = maxIndex + 1
*
* Bis zur Laenge des kuerzeren Strings sind beide gleich, deshalb
* wird das Vergleichsergebnis jetzt aus den Laengen der beiden
* Strings gebildet.
*)
IF HIGH( string1 ) < HIGH( string2 ) THEN
(* Index <= HIGH( string2 )
*)
IF string2[ Index ] = EOS THEN
RETURN( equal );
ELSE
RETURN( less );
END; (* IF string2[ Index ] *)
ELSIF HIGH( string1 ) > HIGH( string2 ) THEN
(* Index <= HIGH( string1 )
*)
IF string1[ Index ] = EOS THEN
RETURN( equal );
ELSE
RETURN( greater );
END; (* IF string1[ Index ] *)
ELSE (* HIGH( string1 ) = HIGH( string2 ) *)
RETURN( equal );
END; (* IF HIGH( string1 ) < HIGH( string2 ) *);
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
string2 EQU 12
HIGH2 EQU string2 + 4
string1 EQU HIGH2 + 2
HIGH1 EQU string1 + 4
RETURN EQU HIGH1 + 2
less EQU 0
equal EQU 1
greater EQU 2
Compare:
moveq #equal, d2 ; Default: Strings gleich
movea.l string1(a6), a0 ; a0 -> string1
movea.l string2(a6), a1 ; a1 -> string2
move.w HIGH1(a6), d0 ; d0 := MIN(HIGH(string1),HIGH(string2))
cmp.w HIGH2(a6), d0 ;
bls.s eqlp ;
move.w HIGH2(a6), d0 ;
eqlp:
move.b (a0)+, d1 ; naechstes Zeichen von <string1>
beq.s tstless ; B: <string1> zuende
cmp.b (a1)+, d1 ; mit <string2> vergleichen
dbne d0, eqlp ; bis ungleiches Zeichen entdeckt
bhi.s gr ; Zeichen von <string1> ist groesser
blo.s ls ; -"- kleiner
; Wenn die Zeichen bis zur Laenge des kuerzeren Strings gleich sind,
; Ergebnis aus der Laenge der Strings bilden
move.w HIGH1(a6), d0
cmp.w HIGH2(a6), d0
beq.s ende ; B: Strings sind gleichlang also gleich
blo.s tstless ; B: <string1> zuende
tst.b (a0) ; <string2> war zuende
beq.s ende ; B: <string1> auch, also gleich
gr:
moveq #greater, d2 ; sonst <string1> groesser, da laenger
bra.s ende
tstless:
tst.b (a1) ; ist <string2> auch zuende ?
beq.s ende ; B: ja, Strings gleich
ls:
moveq #less, d2 ; sonst <strings> kleiner, da kuerzer
ende:
move.b d2, RETURN(a6)
*)
INLINE( 7401H,206EH,0012H,226EH,000CH,302EH,0016H,0B06EH,0010H );
INLINE( 6304H,302EH,0010H,1218H,671EH,0B219H,56C8H,0FFF8H,6212H );
INLINE( 6518H,302EH,0016H,0B06EH,0010H,6710H,6508H,4A10H,670AH );
INLINE( 7402H,6006H,4A11H,6702H,7400H,1D42H,0018H );
END Compare;
(* ------------------------------------------------------------------------- *)
PROCEDURE LeftPos ((* EIN/ -- *) muster : ARRAY OF CHAR;
(* EIN/ -- *) start : CARDINAL;
(* EIN/ -- *) string : ARRAY OF CHAR;
(* EIN/ -- *) links : BOOLEAN ): CARDINAL;
(*T*)
VAR Versuche,
MusterLaenge,
StringLaenge,
MusterIndex : CARDINAL;
BEGIN
MusterLaenge := Length( muster );
StringLaenge := Length( string );
IF start > 0 THEN
DEC( start );
END;
IF ( MusterLaenge = 0 ) OR
( MusterLaenge > ( MAX(CARDINAL) - start )) OR
(( start + MusterLaenge ) > StringLaenge )
THEN
(* Bei arithmetischem Ueberlauf von <start> + <MusterLaenge>
* kann das Muster auch nicht in <string> auftreten
*)
RETURN( 0 );
ELSE
Versuche := StringLaenge - MusterLaenge - start;
(* Sooft muss das Muster maximal - um eine Position nach rechts
* versetzt - erneut mit dem String verglichen werden. Wenn dann noch
* keine Uebereinstimmung festgestellt wurde, ist <muster> nicht
* enthalten, da der Reststring kuerzer als <muster> ist.
*)
END;
LOOP
MusterIndex := 0;
(* Bis zum Musterende oder dem ersten unterschiedlichen Zeichen
* suchen
*)
WHILE ( MusterIndex < MusterLaenge ) &
( string[ start ] = muster[ MusterIndex ] )
DO
INC( start );
INC( MusterIndex );
END; (* WHILE *)
DEC( start, MusterIndex );
IF MusterIndex = MusterLaenge THEN
(* Bis zum Ende von <muster> stimmt alles ueberein,
* also gefunden
*)
IF links THEN
RETURN( start + 1 );
ELSE
RETURN( StringLaenge - start );
END;
END; (* IF MusterIndex *)
IF Versuche = 0 THEN
RETURN( 0 );
END;
INC( start ); (* eins weiter rechts versuchen *)
DEC( Versuche );
END; (* LOOP *)
END LeftPos;
(* ------------------------------------------------------------------------- *)
PROCEDURE RightPos ((* EIN/ -- *) muster : ARRAY OF CHAR;
(* EIN/ -- *) start : CARDINAL;
(* EIN/ -- *) string : ARRAY OF CHAR;
(* EIN/ -- *) links : BOOLEAN ): CARDINAL;
(*T*)
VAR MusterLaenge,
StringLaenge,
MusterIndex : CARDINAL;
BEGIN
MusterLaenge := Length( muster );
StringLaenge := Length( string );
IF ( MusterLaenge = 0 ) OR ( StringLaenge = 0 ) OR
( MusterLaenge > StringLaenge )
THEN
RETURN( 0 );
END;
IF ( start = 0 ) OR ( start > StringLaenge - MusterLaenge ) THEN
(* Soweit hinten wie sinnvoll mit der Suche beginnen, d.h. es
* muessen mindestens Length( string ) Zeichen mit dem String
* verglichen werden koennen.
*)
start := StringLaenge - MusterLaenge;
ELSE
DEC( start );
END;
LOOP
MusterIndex := 0;
WHILE ( MusterIndex < MusterLaenge ) &
( string[ start ] = muster[ MusterIndex ] )
DO
INC( start );
INC( MusterIndex );
END; (* WHILE *)
DEC( start, MusterIndex );
IF MusterIndex = MusterLaenge THEN (* gefunden *)
IF links THEN
RETURN( start + 1 );
ELSE
RETURN( StringLaenge - start );
END;
END; (* IF MusterIndex *)
IF start = 0 THEN
RETURN( 0 );
END;
DEC( start );
END; (* LOOP *)
END RightPos;
(* ------------------------------------------------------------------------- *)
PROCEDURE LeftStr ((* EIN/ -- *) quelle : ARRAY OF CHAR;
(* EIN/ -- *) anzahl : CARDINAL;
(* -- /AUS *) VAR ziel : ARRAY OF CHAR;
(* -- /AUS *) VAR vollst : BOOLEAN );
(*T*)
(* VAR Index,
MaxIndex : INTEGER; (* MaxIndex evtl. = -1 *) *)
BEGIN
(* IF anzahl > VAL( CARDINAL, HIGH( quelle )) THEN
(* Mehr als den Quellstring kann man nicht kopieren
*)
anzahl := HIGH( quelle ) + 1;
END;
IF anzahl > VAL( CARDINAL, HIGH( ziel )) THEN
(* Der Zielstring kann nicht soviel aufnehmen
*)
MaxIndex := HIGH( ziel );
ELSE
MaxIndex := VAL( INTEGER, anzahl ) - 1;
(* Falls <anzahl> gleich Null ist, wird die Schleife
* nicht durchlaufen.
*)
END;
Index := 0;
WHILE ( Index <= MaxIndex ) & ( quelle[ Index ] # EOS ) DO
ziel[ Index ] := quelle[ Index ];
INC( Index );
END;
IF ( Index = VAL( INTEGER, anzahl )) OR
( quelle[ Index ] = EOS )
THEN
vollst := TRUE;
IF Index <= HIGH( ziel ) THEN
ziel[ Index ] := EOS;
END;
ELSE
vollst := FALSE;
END;
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
vollst EQU 12
ziel EQU vollst + 4
ZHIGH EQU ziel + 4
anzahl EQU ZHIGH + 2
quelle EQU anzahl + 2
QHIGH EQU quelle + 4
LeftStr:
moveq #0, d1
movea.l quelle(a6), a0 ; a0 -> quelle, lokale Variable
movea.l ziel(a6), a1 ; a1 -> ziel
move.w anzahl(a6), d0
beq.s exit ; B: anzahl = 0 gibt Leerstring
subq.w #1, d0 ; d0 := MIN(anzahl-1,HIGH(quelle))
cmp.w QHIGH(a6), d0 ;
bls.s clcidx ; <=> Anzahl-1 Zeichen zu kopieren
move.w QHIGH(a6), d0 ;
clcidx:
move.w d0, d3 ; Anzahl-1 fuer spaeteren vollst-Test
cmp.w ZHIGH(a6), d0 ; MaxIndex := MIN(>d0<,HIGH(ziel))
bls.s asgnlp ;
move.w ZHIGH(a6), d0 ;
asgnlp:
move.b (a0)+, (a1)+ ; ein Zeichen kopieren
dbeq d0, asgnlp ; B: noch nicht max. Anzahl Zeichen kopiert
beq.s voll ; Zielstring ist schon mit 0C abgeschlossen
move.l a0, d2 ; d2 := Index ( = Anzahl kop. Zeichen )
movea.l quelle(a6), a2 ;
sub.l a2, d2 ;
cmp.w d3, d2 ; Index > Anzahl-1 ?
bhi.s tsteos ; B: ja, benoetigte Anzahl kopiert
tst.b (a0) ; hinter dem letzten kopierten Zeichen EOS ?
bne.s ende ; B: nein, dann weniger kopiert
tsteos:
cmp.w ZHIGH(a6), d2 ; Ist im Zielstring noch Platz fuer Nullbyte ?
bhi.s voll ; B: nein, Ziel voll
exit:
clr.b (a1) ; <ziel> Ende kennzeichnen
voll:
moveq #1, d1 ; <ziel> ist vollstaendig
ende:
movea.l vollst(a6), a0 ; vollst VAR-Parameter !
move.b d1, (a0) ; vollst setzen
*)
INLINE( 7200H,206EH,0018H,226EH,0010H,302EH,0016H,6736H,5340H );
INLINE( 0B06EH,001CH,6304H,302EH,001CH,3600H,0B06EH,0014H,6304H );
INLINE( 302EH,0014H,12D8H,57C8H,0FFFCH,6718H,2408H,246EH,0018H );
INLINE( 948AH,0B443H,6204H,4A10H,660AH,0B46EH,0014H,6202H,4211H );
INLINE( 7201H,206EH,000CH,1081H );
END LeftStr;
(* ------------------------------------------------------------------------- *)
PROCEDURE RightStr ((* EIN/ -- *) quelle : ARRAY OF CHAR;
(* EIN/ -- *) anzahl : CARDINAL;
(* -- /AUS *) VAR ziel : ARRAY OF CHAR;
(* -- /AUS *) VAR vollst : BOOLEAN );
(*T*)
(* VAR QuellIndex : CARDINAL;
ZielIndex,
MaxIndex : INTEGER; (* MaxIndex evtl. = -1 *) *)
BEGIN
(* QuellIndex := Length( quelle );
IF anzahl > QuellIndex THEN
(* <quelle> hat nur <QuellIndex> Zeichen
*)
anzahl := QuellIndex;
END;
IF anzahl > VAL( CARDINAL, HIGH( ziel )) THEN
MaxIndex := HIGH( ziel );
ELSE
MaxIndex := VAL( INTEGER, anzahl ) - 1;
END;
ZielIndex := 0;
DEC( QuellIndex, anzahl );
(* QuellIndex ist der Index des ersten zu
* kopierenden Zeichens
*)
WHILE ZielIndex <= MaxIndex DO
ziel[ ZielIndex ] := quelle[ QuellIndex ];
INC( ZielIndex );
INC( QuellIndex );
END;
IF VAL( CARDINAL, ZielIndex ) = anzahl THEN
(* die gewuenschte Anzahl Zeichen wurde kopiert
*)
vollst := TRUE;
IF ZielIndex <= HIGH( ziel ) THEN
ziel[ ZielIndex ] := EOS;
END;
ELSE
vollst := FALSE;
END;
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
vollst EQU 12
ziel EQU vollst + 4
ZHIGH EQU ziel + 4
anzahl EQU ZHIGH + 2
quelle EQU anzahl + 2
QHIGH EQU quelle + 4
RightStr:
moveq #0, d1
movea.l quelle(a6), a0 ; a0 -> quelle, lokale Variable
movea.l ziel(a6), a1 ; a1 -> ziel
move.w QHIGH(a6), d0 ;
move.w d0, d2
lenlp:
tst.b (a0)+ ;
dbeq d0, lenlp ;
sub.w d0, d2 ; d2 := Length( quelle ) = QuellIndex
beq.s exit ; QuellLaenge = Null ergibt Leerstring
move.w anzahl(a6), d0
beq.s exit ; B: anzahl = 0 gibt auch Leerstring
cmp.w d2, d0 ; d0 := MIN(anzahl,Length(quelle))
bls.s clcidx ;
move.w d2, d0 ; <=> Anzahl Zeichen zu kopieren
clcidx:
move.w d0, d3 ; fuer spaeteren vollst-Test merken
sub.w d0, d2 ; DEC(QuellIndex,anzahl)
subq.w #1, d0 ; >d0<+1 Zeichen zu kopieren
cmp.w ZHIGH(a6), d0 ; MaxIndex := MIN(>d0<,HIGH(ziel))
bls.s clcstart
move.w ZHIGH(a6), d0 ; >d0<+1 Zeichen zu kopieren
clcstart:
movea.l quelle(a6), a0
adda.w d2, a0 ; a0 -> quelle[ start ]
asgnlp:
move.b (a0)+, (a1)+ ; ein Zeichen kopieren
dbra d0, asgnlp ; B: noch nicht max. moegliche Anzahl kopiert
move.l a1, d2 ; d2 := ZielIndex
movea.l ziel(a6), a2 ;
sub.l a2, d2 ;
cmp.w d3, d2 ; ZielIndex = anzahl ?
blo.s ende ; B: nein, benoetigte Anzahl nicht kopiert
tsteos:
cmp.w ZHIGH(a6), d2 ; Ist im Zielstring noch Platz fuer Nullbyte ?
bhi.s voll ; B: nein, Ziel voll
exit:
clr.b (a1) ; <ziel>-Ende kennzeichnen
voll:
moveq #1, d1 ; <ziel> ist vollstaendig
ende:
movea.l vollst(a6), a0 ; vollst VAR-Parameter !
move.b d1, (a0) ; vollst setzen
*)
INLINE( 7200H,206EH,0018H,226EH,0010H,302EH,001CH,3400H,4A18H );
INLINE( 57C8H,0FFFCH,9440H,673AH,302EH,0016H,6734H,0B042H,6302H );
INLINE( 3002H,3600H,9440H,5340H,0B06EH,0014H,6304H,302EH,0014H );
INLINE( 206EH,0018H,0D0C2H,12D8H,51C8H,0FFFCH,2409H,246EH,0010H );
INLINE( 948AH,0B443H,650AH,0B46EH,0014H,6202H,4211H,7201H,206EH );
INLINE( 000CH,1081H );
END RightStr;
(* ------------------------------------------------------------------------- *)
PROCEDURE SubStr ((* EIN/ -- *) quelle : ARRAY OF CHAR;
(* EIN/ -- *) start : CARDINAL;
(* EIN/ -- *) laenge : CARDINAL;
(* -- /AUS *) VAR ziel : ARRAY OF CHAR;
(* -- /AUS *) VAR vollst : BOOLEAN );
(*T*)
(* VAR QuellLaenge,
Anzahl : CARDINAL;
ZielIndex,
MaxIndex : INTEGER; *)
BEGIN
(* QuellLaenge := Length( quelle );
IF start > 0 THEN
DEC( start );
END;
IF ( laenge > ( MAX(CARDINAL) - start )) OR (* Ueberlauf *)
(( start + laenge ) > QuellLaenge )
THEN
(* Der Substring liegt teilweise oder ganz ausserhalb
* von <string>, <Anzahl> enthaelt die Anzahl Zeichen
* von <start> bis zum Ende von <quelle>, die als Teilstring
* in Frage kommen. Ist <Anzahl> negativ, wird die
* Zuweisungsschleife nicht durchlaufen, und <ziel>
* wird zum Leerstring.
*)
IF start < QuellLaenge THEN
Anzahl := QuellLaenge - start;
ELSE
Anzahl := 0;
END;
ELSE
Anzahl := laenge;
END; (* IF laenge > *)
IF Anzahl > VAL( CARDINAL, HIGH( ziel )) THEN
(* Der Zielstring kann nicht soviel aufnehmen
*)
MaxIndex := HIGH( ziel );
ELSE
MaxIndex := VAL( INTEGER, Anzahl - 1 );
END; (* IF Anzahl > *)
ZielIndex := 0;
WHILE ZielIndex <= MaxIndex DO
ziel[ ZielIndex ] := quelle[ start ];
INC( ZielIndex );
INC( start );
END;
IF VAL( CARDINAL, ZielIndex ) >= Anzahl THEN
vollst := TRUE;
IF ZielIndex <= HIGH( ziel ) THEN
ziel[ ZielIndex ] := EOS;
END;
ELSE
vollst := FALSE;
END;
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
vollst EQU 12
ziel EQU vollst + 4
ZHIGH EQU ziel + 4
laenge EQU ZHIGH + 2
start EQU laenge + 2
quelle EQU start + 2
QHIGH EQU quelle + 4
SubStr:
moveq #0, d4
movea.l quelle(a6), a0 ; a0 -> quelle, lokale Variable
movea.l ziel(a6), a1 ; a1 -> ziel
move.w QHIGH(a6), d0 ;
move.w d0, d2
lenlp:
tst.b (a0)+ ;
dbeq d0, lenlp ;
sub.w d0, d2 ; d2 := Length( quelle ) = QuellIndex
move.w start(a6), d0
beq.s clcanz ; <start> = 0 <=> <start> = 1
subq.w #1, d0 ; DEC(start)
clcanz:
move.w d0, d1 ; d1 := start
move.w d0, d3 ; d3 := start
add.w laenge(a6), d0
bcs.s tststart ; B: Ueberlauf, auch groesser
cmp.w d2, d0 ; start+laenge > QuellLaenge ?
bls.s passt ; B: nein, <laenge> passt
tststart:
cmp.w d2, d1 ; start >= QuellLaenge ?
bhs.s exit ; B: ja, ergibt Nullstring
sub.w d1, d2 ; d2 := QuellLaenge - start ( > 0 )
bra.s clcmax
passt:
move.w laenge(a6), d2 ; Anzahl := laenge
beq.s exit
clcmax:
move.w d2, d1 ; Anzahl fuer vollst-Test merken
subq.w #1, d2 ;
cmp.w ZHIGH(a6), d2 ;
bls.s clcidx ;
move.w ZHIGH(a6), d2 ; d2:=MIN(Anzahl-1,HIGH(ziel)) = MaxIndex >= 0
clcidx:
movea.l quelle(a6), a0 ;
adda.w d3, a0 ; a0 := quelle[start]
loop:
move.b (a0)+, (a1)+ ; ein Zeichen kopieren
dbra d2, loop ; B: noch nicht max. Anzahl Zeichen kopiert
move.l a1, d2 ; d2 := ZielIndex
movea.l ziel(a6), a2 ;
sub.l a2, d2 ;
cmp.w d1, d2 ; ZielIndex = anzahl ?
blo.s ende ; B: nein, benoetigte Anzahl nicht kopiert
tsteos:
cmp.w ZHIGH(a6), d2 ; Ist im Zielstring noch Platz fuer Nullbyte ?
bhi.s voll ; B: nein, Ziel voll
exit:
clr.b (a1) ; <ziel>-Ende kennzeichnen
voll:
moveq #1, d4 ; <ziel> ist vollstaendig
ende:
movea.l vollst(a6), a0 ; vollst VAR-Parameter !
move.b d4, (a0) ; vollst setzen
*)
INLINE( 7800H,206EH,001AH,226EH,0010H,302EH,001EH,3400H,4A18H );
INLINE( 57C8H,0FFFCH,9440H,302EH,0018H,6702H,5340H,3200H,3600H );
INLINE( 0D06EH,0016H,6504H,0B042H,6308H,0B242H,6436H,9441H,6006H );
INLINE( 342EH,0016H,672CH,3202H,5342H,0B46EH,0014H,6304H,342EH );
INLINE( 0014H,206EH,001AH,0D0C3H,12D8H,51CAH,0FFFCH,2409H,246EH );
INLINE( 0010H,948AH,0B441H,650AH,0B46EH,0014H,6202H,4211H,7801H );
INLINE( 206EH,000CH,1084H );
END SubStr;
(* ------------------------------------------------------------------------- *)
PROCEDURE CAPStr ((* EIN/ -- *) quelle : ARRAY OF CHAR;
(* -- /AUS *) VAR ziel : ARRAY OF CHAR;
(* -- /AUS *) VAR vollst : BOOLEAN );
(*T*)
(* Wie "Assign", nur ein CAP in der Zuweisung *)
(* VAR Index,
MaxIndex : CARDINAL; *)
BEGIN
(* IF HIGH( quelle ) > HIGH( ziel ) THEN
MaxIndex := HIGH( ziel );
ELSE
MaxIndex := HIGH( quelle );
END;
Index := 0;
WHILE ( Index <= MaxIndex ) & ( quelle[ Index ] # EOS ) DO
ziel[ Index ] := CAP( quelle[ Index ]);
INC( Index );
END;
IF ( Index > VAL( CARDINAL, HIGH( quelle ))) OR
( quelle[ Index ] = EOS )
THEN
vollst := TRUE;
IF Index <= VAL( CARDINAL, HIGH( ziel )) THEN
ziel[ Index ] := EOS;
END;
ELSE
vollst := FALSE;
END;
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
vollst EQU 12
ziel EQU vollst + 4
ZHIGH EQU ziel + 4
quelle EQU ZHIGH + 2
QHIGH EQU quelle + 4
CAPStr:
moveq #0, d1
movea.l quelle(a6), a0
movea.l ziel(a6), a1
move.w QHIGH(a6), d0
cmp.w ZHIGH(a6), d0
bls.s ucslp
move.w ZHIGH(a6), d0
ucslp:
move.b (a0)+, d2 ; naechstes Zeichen aus Quellstring holen
cmpi.b #'a', d2 ; wenn Kleinbuchstabe...
blo.s ucschr ;
cmpi.b #'z', d2 ;
bhi.s ucschr ;
andi.b #%11011111, d2 ;...dann in Grossbuchstabe wandeln
ucschr:
move.b d2, (a1)+ ; Zeichen kopieren
dbeq d0, ucslp
beq.s voll
move.l a0, d2
movea.l quelle(a6), a2
sub.l a2, d2
cmp.w QHIGH(a6), d2
bhi.s tsteos
tst.b (a0)
bne.s ende
tsteos:
cmp.w ZHIGH(a6), d2
bhi.s voll
clr.b (a1)
voll:
moveq #1, d1
ende:
movea.l vollst(a6), a0
move.b d1, (a0)
*)
INLINE( 7200H,206EH,0016H,226EH,0010H,302EH,001AH,0B06EH,0014H );
INLINE( 6304H,302EH,0014H,1418H,0C02H,0061H,650AH,0C02H,007AH );
INLINE( 6204H,0202H,00DFH,12C2H,57C8H,0FFEAH,671AH,2408H,246EH );
INLINE( 0016H,948AH,0B46EH,001AH,6204H,4A10H,660AH,0B46EH,0014H );
INLINE( 6202H,4211H,7201H,206EH,000CH,1081H );
END CAPStr;
(* ------------------------------------------------------------------------- *)
PROCEDURE CharToStr ((* EIN/ -- *) zeichen : CHAR;
(* -- /AUS *) VAR string : ARRAY OF CHAR );
(*T*)
BEGIN
string[ 0 ] := zeichen;
(* Wenn noch Platz ist, mit Nullbyte abschliessen
*)
IF HIGH( string ) > 0 THEN
string[ 1 ] := EOS;
END;
END CharToStr;
(* ------------------------------------------------------------------------- *)
PROCEDURE GetChar ((* EIN/ -- *) string : ARRAY OF CHAR;
(* EIN/ -- *) pos : CARDINAL ): CHAR;
(*T*)
(* VAR Index : CARDINAL; *)
BEGIN
(* IF ( pos = 0 ) OR ( pos > VAL( CARDINAL, HIGH( string ) + 1 )) THEN
RETURN( EOS );
END;
DEC( pos );
(* 0 <= pos <= HIGH( string ) *)
Index := 0;
WHILE ( string[ Index ] # EOS ) & ( Index < pos ) DO
(* (0<=Index<pos) & ((0<=i<=Index) => (string[i] # EOS ))
*)
INC( Index );
END;
(* (Index=pos) OR (string[Index] = EOS)
*
* Falls 'pos' hinter dem Stringende liegt, wird wegen der
* Endemarkierung trotzdem automatisch 'EOS' zurueckgegeben
*)
RETURN( string[ Index ] );
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
pos EQU 12 ; letzter Parameter
string EQU pos+2
HIGH EQU string+4
RETURN EQU HIGH+2
GetChar:
moveq #0, d1 ; Default: RETURN = EOS
move.w pos(a6), d0 ;
subq.w #1, d0 ; DEC( pos ) ( pos = 0 ==> pos = MAX( CARD )
cmp.w HIGH(a6), d0 ; pos > HIGH( string ) ?
bhi.s ende ; B: ja, EOS zurueckgeben
movea.l string(a6), a0 ; a0 -> lokale Stringvariable
getlp:
move.b (a0)+, d1 ; Position oder Stringende erreicht ?
dbeq d0, getlp ; B: noch nicht
ende: ; Zeichen in d1
move.b d1, RETURN(a6) ; Funktionswert uebergeben
*)
INLINE( 7200H,302EH,000CH,5340H,0B06EH,0012H,620AH,206EH,000EH );
INLINE( 1218H,57C8H,0FFFCH,1D41H,0014H );
END GetChar;
(* ------------------------------------------------------------------------- *)
PROCEDURE AssignChar ((* EIN/ -- *) zeichen: CHAR;
(* EIN/ -- *) pos : CARDINAL;
(* EIN/AUS *) VAR string : ARRAY OF CHAR );
(*T*)
(* VAR Index : CARDINAL; *)
BEGIN
(*
IF ( pos = 0 ) OR ( pos > VAL( CARDINAL, HIGH( string ) + 1 )) THEN
(* Wenn <pos> ausserhalb des Strings liegt, nichts zuweisen
*)
RETURN;
END;
DEC( pos );
Index := 0;
WHILE ( string[ Index ] # EOS ) & ( Index < pos ) DO
(* (0<=Index<pos) & ((0<=i<=Index) => (string[i] # EOS))
*)
INC( Index );
END;
(* (string[Index] = EOS) OR (Index = pos)
*)
IF string[ Index ] # EOS THEN
string[ Index ] := zeichen;
END;
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
string EQU 12
HIGH EQU string + 4
pos EQU HIGH + 2
zeichen EQU pos + 2
AssignChar:
move.w pos(a6), d0 ; Index des zu ueberschreibenden Zeichens
subq.w #1, d0 ; Falls pos = 0 => pos = MAX(CARDINAL)
cmp.w HIGH(a6), d0 ; Index ausserhalb des Feldes ?
bhi.s ende ; B: ja, nichts machen
movea.l string(a6), a0 ; a0 -> string
tstend:
tst.b (a0)+ ; Schleife bis <pos> oder Stringende
dbeq d0, tstend ; erreicht ist
beq.s ende ; B: Stringende, nichts machen
move.b zeichen(a6), -1(a0) ; sonst Zeichen ueberschreiben
ende:
*)
INLINE( 302EH,0012H,5340H,0B06EH,0010H,6212H,206EH,000CH,4A18H );
INLINE( 57C8H,0FFFCH,6706H,116EH,0014H,0FFFFH );
END AssignChar;
(* ------------------------------------------------------------------------- *)
PROCEDURE AppendChar ((* EIN/ -- *) zeichen: CHAR;
(* EIN/AUS *) VAR string : ARRAY OF CHAR;
(* -- /AUS *) VAR vollst : BOOLEAN );
(*T*)
(* VAR Laenge : CARDINAL; *)
BEGIN
(* vollst := TRUE;
Laenge := 0;
(* Erst mal das Ende des Strings suchen
*)
WHILE ( Laenge <= VAL( CARDINAL, HIGH( string ))) &
( string[ Laenge ] # EOS )
DO
INC( Laenge );
END;
IF Laenge <= VAL( CARDINAL, HIGH( string )) THEN
(* Es ist noch Platz fuer das anzuhaengende Zeichen
*)
string[ Laenge ] := zeichen;
IF Laenge < VAL( CARDINAL, HIGH( string )) THEN
(* Es ist sogar noch Platz fuer das abschliessende
* Nullbyte
*)
string[ Laenge + 1 ] := EOS;
END;
ELSIF zeichen # 0C THEN
(* Ein Nullbyte braucht keinen Platz, da es nicht
* zum String gehoert, sondern sein Ende kennzeichnet;
* Ist <string> also voll und soll ein Nullbyte an-
* gehaengt werden, so ist der String trotzdem vollstaendig
*)
vollst := FALSE;
END; (* IF *)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
vollst EQU 12
string EQU vollst + 4
HIGH EQU string + 4
zeichen EQU HIGH + 2
AppendChar:
movea.l string(a6), a0
move.w HIGH(a6), d0
moveq #1, d1 ; Default: vollst = FALSE
tst.b zeichen(a6) ; Ist <zeichen> ein Nullbyte ?
beq.s ende ; B: ja, wird ignoriert
lenlp:
tst.b (a0)+ ; Stringende erreicht ?
dbeq d0, lenlp ; B: nein
bne.s false ; B: ja, aber kein Platz mehr
move.b zeichen(a6), -1(a0) ; Nullbyte ueberschreiben
tst.w d0 ; Noch Platz fuer neues Nullbyte ?
beq.s ende ; B: nein
clr.b (a0) ; Nullbyte anfuegen
bra.s ende
false:
moveq #0, d1
ende:
movea.l vollst(a6), a0 ; <vollst> setzen
move.b d1, (a0)
*)
INLINE( 206EH,0010H,302EH,0014H,7201H,4A2EH,0016H,6718H,4A18H );
INLINE( 57C8H,0FFFCH,660EH,116EH,0016H,0FFFFH,4A40H,6706H,4210H );
INLINE( 6002H,7200H,206EH,000CH,1081H );
END AppendChar;
(* ------------------------------------------------------------------------- *)
PROCEDURE DeleteChar ((* EIN/AUS *) VAR string : ARRAY OF CHAR;
(* EIN/ -- *) pos : CARDINAL );
(*T*)
(* VAR StringLaenge,
Index : CARDINAL; *)
BEGIN
(* StringLaenge := Length( string );
IF StringLaenge = 0 THEN
(* Hier kann nichts geloescht werden
*)
RETURN
END;
IF ( 0 < pos ) & ( pos < StringLaenge ) THEN
FOR Index := pos TO StringLaenge - 1 DO
(* (pos<=Index<StringLaenge ) &
* ((pos<=i<Index) => (string[i-1] = string[i])
*)
string[ Index - 1 ] := string[ Index ];
END; (* FOR *)
(* (pos<=i<StringLaenge) => (string[i-1] = string[i])
*)
END; (* IF *)
string[ StringLaenge - 1 ] := EOS;
(* Endekennung ohne Abfrage, da der String immer um
* ein Zeichen kuerzer wird.
* Falls <pos> ausserhalb von <string> liegt,
* wird dabei gleich der letzte Buchstabe geloescht
*)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
pos EQU 12
string EQU pos + 2
HIGH EQU string + 4
DeleteChar:
movea.l string(a6), a0 ; a0 -> <string>
move.w HIGH(a6), d0 ; d0 := HIGH(string)
move.w d0, d2
lenlp: ; d2 := Length(string)
tst.b (a0)+ ;
dbeq d0, lenlp ;
sub.w d0, d2 ;
beq.s ende ; Es gibt nichts zu loeschen
movea.l string(a6), a1 ; damit steht a1 auf dem letzten Zeichen
adda.w d2, a1 ; falls nur das letzte Zeichen geloescht
subq.l #1, a1 ; werden soll
move.w pos(a6), d0 ; d0 := <pos>
beq.s eos ; B: letztes Zeichen loeschen
cmp.w d2, d0 ; pos >= StringLaenge ?
bhs.s eos ; B: ja, auch letztes Zeichen loeschen
movea.l string(a6), a0
adda.w d0, a0 ; Start mit <string[<pos>]
movea.l a0, a1 ; Ziel ist ein Zeichen vorher
subq.l #1, a1 ;
sub.w d0, d2 ; Anzahl zu verschiebender Zeichen
bra.s dellp + 2
dellp: ; ab <pos> <string> um ein Zeichen nach vorne
move.b (a0)+, (a1)+ ; schieben, zuletzt steht a1 auf dem letzten
dbra d2, dellp ; Zeichen des urspruenglichen Strings
eos:
clr.b (a1) ; und dort ist jetzt das Stringende
ende:
*)
INLINE( 206EH,000EH,302EH,0012H,3400H,4A18H,57C8H,0FFFCH,9440H );
INLINE( 6728H,226EH,000EH,0D2C2H,5389H,302EH,000CH,6718H,0B042H );
INLINE( 6414H,206EH,000EH,0D0C0H,2248H,5389H,9440H,6002H,12D8H );
INLINE( 51CAH,0FFFCH,4211H );
END DeleteChar;
(* ------------------------------------------------------------------------- *)
PROCEDURE InsertChar ((* EIN/ -- *) zeichen: CHAR;
(* EIN/ -- *) pos : CARDINAL;
(* EIN/AUS *) VAR string : ARRAY OF CHAR;
(* -- /AUS *) VAR vollst : BOOLEAN );
(*T*)
(* VAR StringLaenge,
Frei,
Index : INTEGER; *)
BEGIN
(* vollst := TRUE;
IF zeichen = 0C THEN
(* Einen String kann mit "LeftString" gekuerzt werden
* oder mit "AssignChar" wenns denn unbedingt sein muss
*)
RETURN;
END;
StringLaenge := Length( string );
IF pos > 0 THEN
DEC( pos );
IF pos > VAL( CARDINAL, StringLaenge ) THEN
pos := StringLaenge (* Zeichen wird angehaengt *)
END;
END;
Frei := HIGH( string ) - StringLaenge;
IF Frei = -1 THEN
vollst := FALSE;
IF pos = VAL( CARDINAL, StringLaenge ) THEN
(* <zeichen> geht verloren
*)
RETURN;
ELSE
(* letztes Zeichen von <string>geht verloren
*)
DEC( StringLaenge );
END; (* IF pos *)
ELSIF Frei >= 1 THEN (* Platz fuer Nullbyte *)
string[ StringLaenge + 1 ] := EOS;
END;
FOR Index := StringLaenge - 1 TO VAL( INTEGER, pos ) BY -1 DO
(* (StringLaenge>Index>=pos ) &
* ((StringLaenge>i>Index) => (string[i+1] = string[i]))
*)
string[ Index + 1 ] := string[ Index ];
END;
(* (StringLaenge>i>=pos) => (string[i+1] = string[i]
*)
string[ pos ] := zeichen;
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
vollst EQU 12
string EQU vollst + 4
HIGH EQU string + 4
pos EQU HIGH + 2
zeichen EQU pos + 2
InsertChar:
moveq #1, d3 ; Default: vollstaendig
tst.b zeichen(a6) ; Ist <zeichen> das Nullbyte ?
beq.s ende ; B: ja, <string> nicht veraendern
movea.l string(a6), a0 ; a0 -> <string>
move.w HIGH(a6), d0 ; d0 := HIGH(string)
move.w d0, d2
lenlp: ; d2 := Length(string)
tst.b (a0)+ ;
dbeq d0, lenlp ;
sub.w d0, d2
; a0 steht ein Zeichen hinter Feldende
; oder dem Nullbyte, falls der String das Feld
; nicht ausfuellt
move.w pos(a6), d0 ; d0 := <pos>
beq.s clcfrei ; B: ist schon kleinster Index
subq.w #1, d0 ; DEC(pos)
cmp.w d2, d0 ; pos > StringLaenge ?
bls.s clcfrei ; B: nein
move.w d2, d0 ; sonst pos := StringLaenge
clcfrei:
cmp.w HIGH(a6), d2 ; d2 = Frei IN {-1,0,+1}
beq.s shift ; B: Platz reicht, aber nicht fuer EOS
bhi.s short ; B: Platz reicht nicht
clr.b (a0) ; sonst schon mal EOS schreiben ( nur wenn
; der String das Feld nicht vollstaendig
; ausfuellt, sonst wird zu 'short' gesprungen)
bra.s shift
short:
moveq #0, d3 ; nicht vollstaendig
cmp.w d2, d0 ; Sollte <zeichen> angehaengt werden ?
beq.s ende ; B: ja, dafuer ist kein Platz; <string>
; wird nicht veraendert
subq.w #1, d2 ; sonst <string> um letztes Zeichen kuerzen
shift:
movea.l string(a6), a0 ; a0 -> <string>
adda.w d2, a0 ; von hinten verschieben
movea.l a0, a1 ; Ziel ist ein Zeichen weiter hinten
addq.l #1, a1 ;
sub.w d0, d2 ; d2:=Anzahl zu kopierender Zeichen
bra.s inslp + 2
inslp:
move.b -(a0), -(a1)
dbra d2, inslp
move.b zeichen(a6), (a0) ; string[pos] := zeichen
ende:
movea.l vollst(a6), a0
move.b d3, (a0)
*)
INLINE( 7601H,4A2EH,0018H,674CH,206EH,0010H,302EH,0014H,3400H );
INLINE( 4A18H,57C8H,0FFFCH,9440H,302EH,0016H,6708H,5340H,0B042H );
INLINE( 6302H,3002H,0B46EH,0014H,670EH,6204H,4210H,6008H,7600H );
INLINE( 0B042H,671AH,5342H,206EH,0010H,0D0C2H,2248H,5289H,9440H );
INLINE( 6002H,1320H,51CAH,0FFFCH,10AEH,0018H,206EH,000CH,1083H );
END InsertChar;
END Strings.